
open Chipmunk.Low_level

(* this type represents the state of GameEngine,
 * there should be only one instance of this type,
 * when passed as parameter it is called 'ge' *)
type t =
	{         space        : cpSpace
	; mutable playersID    : Types.id_type
	; mutable players      : Player.t Types.IdMap.t
	;         playersMutex : Mutex.t
	; mutable objectsID    : Types.id_type
	; mutable objects      : Object.t Types.IdMap.t
	;         objectsMutex : Mutex.t
	}

let cpv = vec2d
let cpvi (x, y) = { cp_x = float x; cp_y = float y }

(* the step of the simulation
 * large step --> fast, but not precise and not stable
 * small step --> precise, more stable, but slow *)
let dt = Config.dt
(* just for numerical stability, more steps -- slower, but more stable *)
let steps = Config.steps

(* thread safe operations on players and objects maps *)
(* function 'registerPlayer' was merged with 'newPlayer' *)
let players ge =
	(* lock the players map -- enter critical section *)
	let () = Mutex.lock ge.playersMutex in
	(* do whatever we need to do, in this case
	 * copy the map i.e. copy the pointer to it *)
	let result = ge.players in
	(* leave critical section -- unlock the map *)
	let () = Mutex.unlock ge.playersMutex in
	result
let registerObject ge objct = 
	let () = Mutex.lock ge.objectsMutex in
	let result = ge.objectsID in
	let () = ge.objects <- Types.IdMap.add result objct ge.objects in
	let () = ge.objectsID <- ge.objectsID + 1 in
	let () = Mutex.unlock ge.objectsMutex in
	result
let objects ge = 
	let () = Mutex.lock ge.objectsMutex in
	let result = ge.objects in
	let () = Mutex.unlock ge.objectsMutex in
	result

(* hi-level collision handlers *)
(* called when shapes begin to touch *)
let collisionBegin ge idA idB = 
	let players = players ge in
	let playerA = Types.IdMap.find idA players in
	let playerB = Types.IdMap.find idB players in
	let () = Player.collisionBegin ge playerA in
	let () = Player.collisionBegin ge playerB in
	true
let collisionSeparate ge idA idB = 
	let players = players ge in
	let playerA = Types.IdMap.find idA players in
	let playerB = Types.IdMap.find idB players in
	let () = Player.collisionSeparate ge playerA in
	let () = Player.collisionSeparate ge playerB in
	()

(* low-level collision handlers *)
(* called when shapes begin to touch *)
let collisionBeginRaw arbiter space ge = 
	let shapeA = cpArbiterGetPA arbiter in
	let shapeB = cpArbiterGetPB arbiter in
	let bodyA = cpShapeGetBody shapeA in
	let bodyB = cpShapeGetBody shapeB in
	let idA = cpBodyGetData bodyA in
	let idB = cpBodyGetData bodyB in
	collisionBegin ge idA idB
(* called with each update *)
let collisionPreSolveRaw arbiter space ge = 
	true
(* called after update *)
let collisionPostSolveRaw arbiter space ge = 
	()
(* called when shapes separate *)
let collisionSeparateRaw arbiter space ge = 	
	let shapeA = cpArbiterGetPA arbiter in
	let shapeB = cpArbiterGetPB arbiter in
	let bodyA = cpShapeGetBody shapeA in
	let bodyB = cpShapeGetBody shapeB in
	let idA = cpBodyGetData bodyA in
	let idB = cpBodyGetData bodyB in
	let () = collisionSeparate ge idA idB in
	()
let collisionHandler ge : t collisionHandler = (
	collisionBeginRaw, collisionPreSolveRaw,
	collisionPostSolveRaw, collisionSeparateRaw, ge)

(* creates the frame which encloses the game space *)
let createFrame ge = 
	(* create body for the frame with infinite mass and momentum *)
	let frameBody = cpBodyNew infinity infinity in
	(* do not add body to space -> frame is static, no gravity *)
	(* create shapes for the body, just simple square *)
	let frameShape1 = cpSegmentShapeNew frameBody (cpvi(1,1)) (cpvi(1,0)) 0.0 in
	let frameShape2 = cpSegmentShapeNew frameBody (cpvi(1,0)) (cpvi(0,0)) 0.0 in
	let frameShape3 = cpSegmentShapeNew frameBody (cpvi(0,0)) (cpvi(0,1)) 0.0 in
	let frameShape4 = cpSegmentShapeNew frameBody (cpvi(0,1)) (cpvi(1,1)) 0.0 in
	let () = cpShapeSetElasticity frameShape1 1.0 in
	let () = cpShapeSetElasticity frameShape2 1.0 in
	let () = cpShapeSetElasticity frameShape3 1.0 in
	let () = cpShapeSetElasticity frameShape4 1.0 in
	let () = cpShapeSetFriction frameShape1 1.0 in
	let () = cpShapeSetFriction frameShape2 1.0 in
	let () = cpShapeSetFriction frameShape3 1.0 in
	let () = cpShapeSetFriction frameShape4 1.0 in
	(* add the shape to space, so it can interact *)
	let () = cpSpaceAddStaticShape ge.space frameShape1 in
	let () = cpSpaceAddStaticShape ge.space frameShape2 in
	let () = cpSpaceAddStaticShape ge.space frameShape3 in
	let () = cpSpaceAddStaticShape ge.space frameShape4 in
	()  

let init mapFilename = 
	(* init physics engine *)
	let () = cpInitChipmunk () in
	let () = cpResetShapeIdCounter () in
	(* create space for our objects *)
	let space = cpSpaceNew () in
	let () = cpSpaceResizeStaticHash space 20.0 999 in (* TODO check parameters *)
	let () = cpSpaceSetGravity space (cpv (0.0 , -.Config.gravity)) in
	let () = set_cp_collision_slop 1e-4 in
	(* build the state of GameEngine *)
	let ge = 
		{ space
		; playersID = 0
		; players = Types.IdMap.empty
		; playersMutex = Mutex.create ()
		; objectsID = 0
		; objects = Types.IdMap.empty
		; objectsMutex = Mutex.create ()
		}
	in 
	(* init collision handler *)
	let () = Callback.register "collisionHandler" (collisionHandler ge) in
	(* registering handler for collisions between objects of collision type 0,
	 * (this can be set for shapes -- see cpShapeSetCollisionType) *)
	let firstCollisionType = 1 in
	let secondCollisionType = 1 in
	let () = cpSpaceAddCollisionHandler space 
		firstCollisionType secondCollisionType "collisionHandler" in	
	(* create square game border *)
	let () = createFrame ge in
	(* fin *)
	ge

let step ge = 
	let space = ge.space in
	(* iter through the objects in space; we may need another type of objects
	 * -- 'mindless' -- if this function is too slow *)
	let () = Types.IdMap.iter 
		(fun key player -> Player.step player) 
		(players ge) 
	in
	let () = Types.IdMap.iter
		(fun key objct -> Object.step objct)
		(objects ge)
	in
	(* calculate dt for the system *)
	let dt = dt /. (float steps) in
	let () = 
	(* do 'steps' passes for numerical stability *)
		for ii = 0 to pred steps do	
			cpSpaceStep ~space ~dt
		done
	in ()

let newPlayer ge =
	(* get the player id *)
	let () = Mutex.lock ge.playersMutex in
	let id = ge.playersID in
	let () = ge.playersID <- ge.playersID + 1 in
	let () = Mutex.unlock ge.playersMutex in
	(* create player *)
	let player = Player.create ge.space id in
	(* put it in the map *)
	let () = Mutex.lock ge.playersMutex in
	let () = ge.players <- Types.IdMap.add id player ge.players in
	let () = Mutex.unlock ge.playersMutex in
	(* return the id *)
	id
	
let unregisterPlayer ge id = (* TODO *) ()

let rec playerCommand ge player cmd = 
	let player = Types.IdMap.find player (players ge) in
	match cmd with
	| Types.Data.String "getObjects" ->
		Types.Data.List (List.map (fun (_, v) -> Object.show v)
				(Types.IdMap.bindings (objects ge)))
	| Types.Data.String "getPlayers" ->
		Types.Data.List (List.map (fun (_, v) -> Player.show v)
				(Types.IdMap.bindings (players ge)))
	| _ -> Player.command player cmd

let rec engineCommand ge cmd = match cmd with
	| Types.Data.List [
		Types.Data.String "Segment";
		Types.Data.Float startX;
		Types.Data.Float startY;
		Types.Data.Float endX;
		Types.Data.Float endY] -> 
			let obj = Object.Segment.create ge.space startX startY endX endY in
			let _ = registerObject ge (Object.Segment obj) in
			Types.Data.List []
	| Types.Data.List [
		Types.Data.String "Box";
		Types.Data.Float centerX;
		Types.Data.Float centerY;
		Types.Data.Float size;
		Types.Data.Float mass] -> 
			let obj = Object.Box.create ge.space centerX centerY size mass in
			let _ = registerObject ge (Object.Box obj) in
			Types.Data.List []
	| Types.Data.List [
		Types.Data.String "SetGravity";
		Types.Data.Float x;
		Types.Data.Float y] ->
			let () = cpSpaceSetGravity ge.space (cpv (x, y)) in
			Types.Data.List []
	| _ -> Types.Data.List [Types.Data.String "Unknown command!"; cmd]

let rec adminCommand ge cmd = match cmd with
	| Types.Data.List [
		Types.Data.String "repeat";
		Types.Data.Float x;
		cmd' ] -> 
			let n = int_of_float x in
			let () = for ii = 1 to n do
					let _ = adminCommand ge cmd' in ()
				done
			in Types.Data.List []
	| _ -> engineCommand ge cmd
	

